<%
'######################################################################
'## ab.e.rsa.asp
'## -------------------------------------------------------------------
'## Feature     :   RSA Encryption
'## Version     :   v1.0
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2012/01/31 09:16
'## Description :   AspBox RSA Encryption Block
'######################################################################

Class Cls_AB_E_RSA
	Public PublicKey, PrivateKey, Modulus
	Private a_key

	Private Sub Class_Initialize()
		'a_key = Array(32823, 20643, 29893)
		a_key = Array(8993, 4553, 6539)
		PublicKey = a_key(0)
		PrivateKey = a_key(1)
		Modulus = a_key(2)
	End Sub

	Private Sub Class_Terminate()

	End Sub

	'@ =====================================================================================
	'@ 属  性:  AB.RSA.PublicKey 属性 (可读/可写)
	'@ 返  回:  --
	'@ 作  用:  Key for others to encrypt data with.
	'@ 举  例:  AB.RSA.PublicKey = 8993
	'@ PublicKey, PrivateKey, Modulus这三个值可不是能随便乱设的, 
	'@ 一般可以通过 GenKey() 方法产生查看后, 才进行手工修改
	'@ =====================================================================================

	'@ =====================================================================================
	'@ 属  性:  AB.RSA.PrivateKey 属性 (可读/可写)
	'@ 返  回:  --
	'@ 作  用:  Your personal private key. Keep this hidden.
	'@ 举  例:  AB.RSA.PrivateKey = 4553
	'@ =====================================================================================

	'@ =====================================================================================
	'@ 属  性:  AB.RSA.Modulus 属性 (可读/可写)
	'@ 返  回:  --
	'@ 作  用:  Used with both public and private keys when encrypting and decrypting data.
	'@ 举  例:  AB.RSA.Modulus = 6539
	'@ =====================================================================================

	'@ ******************************************************************
	'@ 过程名:  AB.E.RSA.E(Str) {简写为： AB.E.RSA(Str) }
	'@ 返  回:  加密后的字符串
	'@ 作  用:  对字符串进行加密(使用RSA加密算法)
	'==Param==============================================================
	'@ Str  : 待加密的字符串 # [String]
	'==DEMO==============================================================
	'@ AB.E.RSA.PublicKey = 8993
	'@ AB.E.RSA.PrivateKey = 4553
	'@ AB.E.RSA.Modulus = 6539
	'@ AB.E.RSA.E("aspbox") => 0BF10AB104F5155F11D10A58
	'@ ******************************************************************

	Public Default Function E(Byval s)
		AutoGenKey()
		E = Encode(s)
	End Function

	'@ ******************************************************************
	'@ 过程名:  AB.E.RSA.D(Str)
	'@ 返  回:  对由RSA加密算法加密的字符串进行解密还原
	'@ 作  用:  解密由RSA加密算法的字符串
	'==Param==============================================================
	'@ Str  : 待解密的字符串 # [String]
	'==DEMO==============================================================
	'@ AB.E.RSA.PublicKey = 8993
	'@ AB.E.RSA.PrivateKey = 4553
	'@ AB.E.RSA.Modulus = 6539
	'@ AB.E.RSA.D(AB.E.RSA.E("aspbox")) => aspbox
	'@ ******************************************************************

	Public Function D(Byval s)
		AutoGenKey()
		D = Decode(s)
	End Function

	Public Sub AutoGenKey()
		IF PublicKey="" Or PrivateKey="" Or Modulus="" Then GenKey()
	End Sub

	'Creates Public/Private key set and Modulus
	'例： AB.E.RSA.GenKey() : AB.Trace Array(AB.E.RSA.PublicKey, AB.E.RSA.PrivateKey, AB.E.RSA.Modulus)
	Public Sub GenKey()
		Dim lLngPhi
		Dim q
		Dim p
		Randomize
		Do
			Do
				' 2 random primary numbers (0 to 1000)
				Do
					p = Rnd * 1000 \ 1
				Loop While Not IsPrime(p)
				Do
					q = Rnd * 1000 \ 1
				Loop While Not IsPrime(q)
				' n = product of 2 primes
				Modulus = p * q \ 1
				' random decryptor (2 to n)
				PrivateKey = Rnd * (Modulus - 2) \ 1 + 2
				lLngPhi = (p - 1) * (q - 1) \ 1
				PublicKey = Euler(lLngPhi, PrivateKey)
			Loop While PublicKey = 0 Or PublicKey = 1
		' Loop if we can’t crypt/decrypt a byte
		Loop While Not TestCrypt(255)
	End Sub

	'Encrypts message and returns in double-hex format
	Private Function Encode(ByVal pStrMessage)
		Dim lLngIndex
		Dim lLngMaxIndex
		Dim lBytAscii
		Dim lLngEncrypted
		Dim sMessage
		sMessage = pStrMessage
		lLngMaxIndex = Len(sMessage)
		If lLngMaxIndex = 0 Then Exit Function
		'===对于双字节如中文、特殊字符等处理 Begin (By Lajox)
		Dim oStr
		For lLngIndex = 1 To lLngMaxIndex
			Dim tStr
			tStr = Mid(sMessage, lLngIndex, 1)
			lBytAscii = Asc(tStr)
			IF lBytAscii<0 Then
				lBytAscii = lBytAscii + 65535
			End If
			IF lBytAscii>255 Then
				tStr = Escape(tStr)
			End IF
			oStr = oStr & tStr
		Next
		sMessage = oStr
		lLngMaxIndex = Len(sMessage)
		'===对于双字节如中文、特殊字符等处理 End
		For lLngIndex = 1 To lLngMaxIndex
			lBytAscii = Asc(Mid(sMessage, lLngIndex, 1))
			lLngEncrypted = Crypt(lBytAscii, PublicKey)
			Encode = Encode & NumberToHex(lLngEncrypted, 4)
		Next
	End Function

	'Decrypts message from double-hex format and returns a string
	Private Function Decode(ByVal pStrMessage)
		Dim lBytAscii
		Dim lLngIndex
		Dim lLngMaxIndex
		Dim lLngEncryptedData
		Dim sMessage
		sMessage = pStrMessage
		tStr = ""
		lLngMaxIndex = Len(sMessage)
		For lLngIndex = 1 To lLngMaxIndex Step 4
			lLngEncryptedData = HexToNumber(Mid(sMessage, lLngIndex, 4))
			lBytAscii = Crypt(lLngEncryptedData, PrivateKey)
			tStr = tStr & Chr(lBytAscii)
		Next
		Decode = tStr
		'对于双字节如中文、特殊字符等处理 (By Lajox)
		Decode = Unescape(tStr)
	End Function

	'Encrypts/Decrypts message and returns as a string.
	Private Function Crypt(pLngMessage, pLngKey)
		On Error Resume Next
		Dim lLngMod
		Dim lLngResult
		Dim lLngIndex
		If pLngKey Mod 2 = 0 Then
			lLngResult = 1
			For lLngIndex = 1 To pLngKey / 2
				lLngMod = (pLngMessage ^ 2) Mod Modulus
				' Mod may error on key generation
				lLngResult = (lLngMod * lLngResult) Mod Modulus
				If Err Then Exit Function
			Next
		Else
			lLngResult = pLngMessage
			For lLngIndex = 1 To pLngKey / 2
				lLngMod = (pLngMessage ^ 2) Mod Modulus
				On Error Resume Next
				' Mod may error on key generation
				lLngResult = (lLngMod * lLngResult) Mod Modulus
				If Err Then Exit Function
			Next
		End If
		Crypt = lLngResult
		On Error Goto 0
	End Function

	Private Function NumberToHex(ByRef pLngNumber, ByRef pLngLength)
		NumberToHex = Right(String(pLngLength, "0") & Hex(pLngNumber), pLngLength)
	End Function

	Private Function HexToNumber(ByRef pStrHex)
		HexToNumber = CLng("&h" & pStrHex)
	End Function

	Private Function Euler(ByRef pLngPHI, ByRef pLngKey)
		Dim lLngR(3)
		Dim lLngP(3)
		Dim lLngQ(3)
		Dim lLngCounter
		Dim lLngResult
		Euler = 0
		lLngR(1) = pLngPHI: lLngR(0) = pLngKey
		lLngP(1) = 0: lLngP(0) = 1
		lLngQ(1) = 2: lLngQ(0) = 0
		lLngCounter = -1
		Do Until lLngR(0) = 0
			lLngR(2) = lLngR(1): lLngR(1) = lLngR(0)
			lLngP(2) = lLngP(1): lLngP(1) = lLngP(0)
			lLngQ(2) = lLngQ(1): lLngQ(1) = lLngQ(0)
			lLngCounter = lLngCounter + 1
			lLngR(0) = lLngR(2) Mod lLngR(1)
			lLngP(0) = ((lLngR(2)\lLngR(1)) * lLngP(1)) + lLngP(2)
			lLngQ(0) = ((lLngR(2)\lLngR(1)) * lLngQ(1)) + lLngQ(2)
		Loop
		lLngResult = (pLngKey * lLngP(1)) - (pLngPHI * lLngQ(1))
		If lLngResult > 0 Then
			Euler = lLngP(1)
		Else
			Euler = Abs(lLngP(1)) + pLngPHI
		End If
	End Function

	Private Function TestCrypt(ByRef pBytData)
		Dim lStrCrypted
		lStrCrypted = Crypt(pBytData, PublicKey)
		TestCrypt = Crypt(lStrCrypted, PrivateKey) = pBytData
	End Function

	Private Function IsPrime(ByRef pLngNumber)
		Dim lLngSquare
		Dim lLngIndex
		IsPrime = False
		If pLngNumber < 2 Then Exit Function
		If pLngNumber Mod 2 = 0 Then Exit Function
		lLngSquare = Sqr(pLngNumber)
		For lLngIndex = 3 To lLngSquare Step 2
			If pLngNumber Mod lLngIndex = 0 Then Exit Function
		Next
		IsPrime = True
	End Function
End Class
%>